home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 26 / AACD 26.iso / AACD / Programming / ace_gpl_release / src_ansi / ace / c / lex.c < prev    next >
Encoding:
C/C++ Source or Header  |  1999-01-05  |  30.2 KB  |  1,445 lines
  1. /* << ACE >>
  2.  
  3.    -- Amiga BASIC Compiler --
  4.  
  5.    ** Lexical Analyser **
  6.    ** Copyright (C) 1998 David Benn
  7.    ** 
  8.    ** This program is free software; you can redistribute it and/or
  9.    ** modify it under the terms of the GNU General Public License
  10.    ** as published by the Free Software Foundation; either version 2
  11.    ** of the License, or (at your option) any later version.
  12.    **
  13.    ** This program is distributed in the hope that it will be useful,
  14.    ** but WITHOUT ANY WARRANTY; without even the implied warranty of
  15.    ** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16.    ** GNU General Public License for more details.
  17.    **
  18.    ** You should have received a copy of the GNU General Public License
  19.    ** along with this program; if not, write to the Free Software
  20.    ** Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  21.  
  22.    Author: David J Benn
  23.    Date: 18th October-30th November, 1st-13th December 1991,
  24.    14th,20th,26th January 1992, 
  25.    2nd-17th, 23rd-24th February 1992,
  26.    21st April 1992,
  27.    7th,11th,13th June 1992,
  28.    2nd,3rd,4th,5th,8th,14th,15th,16th,19th,26th,28th,29th July 1992,
  29.    2nd,8th August 1992,
  30.    6th,22nd,27th-30th December 1992,
  31.    4th,5th,7th,19th,31st January 1993,
  32.    2nd,6th,11th-15th,19th,28th February 1993,
  33.    1st,24th March 1993,
  34.    12th,17th April 1993,
  35.    6th,13th June 1993,
  36.    1st,2nd,10th July 1993,
  37.    5th,26th September 1993,
  38.    15th November 1993,
  39.    14th,16th,17th,25th,26th December 1993,
  40.    2nd,5th,7th-9th January 1994,
  41.    7th,15th February 1994,
  42.    20th,22nd,28th August 1994,
  43.    4th,10th,11th September 1994,
  44.    7th August 1995,
  45.    6th October 1995,
  46.    10th March 1996,
  47.    11th June 1996,
  48.    4th September 1996
  49.  */
  50.  
  51. #include "lexvar.h"
  52. #include <string.h>
  53. #include <clib/exec_protos.h>
  54. #include <clib/mathffp_protos.h>
  55. #include <clib/mathtrans_protos.h>
  56. #include <stdlib.h>
  57.  
  58. /* globals */
  59.  
  60. struct Library *MathBase = NULL;
  61. struct Library *MathTransBase = NULL;
  62. struct IntuitionBase *IntuitionBase = NULL; 
  63.  
  64.  
  65. BOOL inside_string = FALSE;    /* see last line of nextch() */
  66.  
  67. /* functions */
  68. void open_shared_libs (void)
  69. {
  70.   if ((MathBase = (struct Library *) OpenLibrary ("mathffp.library", 0)) == NULL)
  71.     {
  72.       printf ("Unable to open mathffp.library!\n");
  73.       exit (10);
  74.     }
  75.  
  76.   if ((MathTransBase = (struct Library *) OpenLibrary ("mathtrans.library", 0)) == NULL)
  77.     {
  78.       printf ("Unable to open mathtrans.library!\n");
  79.       exit (10);
  80.     }
  81.  
  82.   if ((IntuitionBase = (struct IntuitionBase *) OpenLibrary ("intuition.library", 0)) == NULL)
  83.     {
  84.       printf ("Unable to open intuition.library!\n");
  85.       exit (10);
  86.     }
  87. }
  88.  
  89. void close_shared_libs (void)
  90. {
  91.   if (IntuitionBase != NULL)
  92.     CloseLibrary ((struct Library *) MathTransBase);
  93.   if (MathTransBase != NULL)
  94.     CloseLibrary ((struct Library *) MathTransBase);
  95.   if (MathBase != NULL)
  96.     CloseLibrary ((struct Library *) MathBase);
  97. }
  98.  
  99. void setup (void)
  100. {
  101.   int i;
  102.  
  103.   /* initialize nextch() variables */
  104.   column = linelen = -1;
  105.   line[0] = '\0';
  106.  
  107.   /* 
  108.      ** All id's default to singletype (A..Z + "_" 
  109.      ** with 4 bytes wasted between Z and "_").
  110.    */
  111.   for (i = 0; i <= 30; i++)
  112.     idtype[i] = singletype;
  113.  
  114.   /* libraries used by ACE */
  115.   strcpy (acelib[0].name, "DOS");
  116.   strcpy (acelib[0].base, "_DOSBase");
  117.   strcpy (acelib[1].name, "INTUITION");
  118.   strcpy (acelib[1].base, "_IntuitionBase");
  119.   strcpy (acelib[2].name, "GRAPHICS");
  120.   strcpy (acelib[2].base, "_GfxBase");
  121.   strcpy (acelib[3].name, "MATHFFP");
  122.   strcpy (acelib[3].base, "_MathBase");
  123.   strcpy (acelib[4].name, "MATHTRANS");
  124.   strcpy (acelib[4].base, "_MathTransBase");
  125.   strcpy (acelib[5].name, "TRANSLATOR");
  126.   strcpy (acelib[5].base, "_TransBase");
  127.   /* sentinel ACE library entry */
  128.   strcpy (acelib[6].name, "SENTINEL");
  129.  
  130.   /* make "other library" entries null */
  131.   for (i = 0; i < NUMLIBS - 1; i++)
  132.     {
  133.       otherlib[i].name[0] = '\0';
  134.       otherlib[i].base[0] = '\0';
  135.     }
  136.   /* sentinel for "other libraries" */
  137.   strcpy (otherlib[NUMLIBS - 1].name, "SENTINEL");
  138.  
  139.   /* open error log? */
  140.   if (error_log)
  141.     {
  142.       err_log = fopen ("ace.err", "w");
  143.       if (err_log == NULL)
  144.     {
  145.       puts ("Unable to open error log: ace.err!");
  146.       exit (10);
  147.     }
  148.     }
  149. }
  150.  
  151. void cleanup (void)
  152. {
  153.   /* close files */
  154.   if (!std_in && src != NULL)
  155.     fclose (src);
  156.   if (dest != NULL)
  157.     fclose (dest);
  158.   if (err_log != NULL)
  159.     fclose (err_log);
  160.  
  161.   free_alloc ();
  162.  
  163.   close_shared_libs ();
  164.  
  165.   /* exit with return value */
  166.   if (early_exit)
  167.     exitvalue = 10;
  168.   exit (exitvalue);
  169. }
  170.  
  171. void _warn (int n)
  172. {
  173.   char *msg;
  174.  
  175.   printf ("Warning: ");
  176.   if (error_log)
  177.     fprintf (err_log, "Warning: ");
  178.  
  179.   switch (n)
  180.     {
  181.     case 0:            /* dummy */
  182.       break;
  183.     case 1:
  184.       msg = "Exponent out of range";
  185.       break;
  186.     }
  187.   printf ("%s", msg);
  188.   if (error_log)
  189.     fprintf (err_log, "%s", msg);
  190.   printf (" in line %d.\n", lineno);
  191.   if (error_log)
  192.     fprintf (err_log, " in line %d.\n", lineno);
  193. }
  194.  
  195. void _error (int n)
  196. {
  197.   int i, spot, badline, length;
  198.   char *msg;
  199.  
  200.   /* display an error and the line in which it occurs */
  201.  
  202.   if (!report_errors)
  203.     return;            /* eg. see assem() in misc.c */
  204.  
  205.   if (n > 1 && n != 8)
  206.     {
  207.       if (n != 12 && n != 15 && n != 17 && n != 25 && n != 34 &&
  208.       n != 51 && n != 52 && n != 64 && n != 73)
  209.     {
  210.       /* show the offending line */
  211.       if (column != 0)
  212.         {
  213.           length = strlen (line);
  214.           if (length > 0)
  215.         {
  216.           printf ("\n%s\n", line);
  217.           if (error_log)
  218.             fprintf (err_log, "\n%s\n", line);
  219.           spot = column;
  220.         }
  221.           badline = lineno;
  222.         }
  223.       else
  224.         {
  225.           length = strlen (lastline);
  226.           if (length > 0)
  227.         {
  228.           printf ("\n%s\n", lastline);
  229.           if (error_log)
  230.             fprintf (err_log, "\n%s\n", lastline);
  231.           spot = length;
  232.         }
  233.           badline = lineno - 1;
  234.         }
  235.  
  236.       if (length > 0)
  237.         {
  238.           /* point to the error */
  239.           for (i = 1; i < spot; i++)
  240.         {
  241.           putchar (' ');
  242.           if (error_log)
  243.             fputc (' ', err_log);
  244.         }
  245.           printf ("^\n");
  246.           if (error_log)
  247.         fprintf (err_log, "^\n");
  248.         }
  249.  
  250.       /* ignore rest of line */
  251.       column = linelen;
  252.       ch = ' ';        /* force a call to nextch() when insymbol() next invoked */
  253.     }
  254.       else
  255.     {
  256.       putchar ('\n');
  257.       if (error_log)
  258.         fputc ('\n', err_log);
  259.       badline = lineno;
  260.     }
  261.  
  262.       printf ("** ");
  263.       if (error_log)
  264.     fprintf (err_log, "** ");
  265.  
  266.       if (!early_exit)
  267.     early_exit = TRUE;
  268.     }
  269.  
  270.   switch (n)
  271.     {
  272.     case 0:            /* dummy */
  273.       break;
  274.     case 1:
  275.       msg = "Unexpected end of source\n";
  276.       break;
  277.     case 2:
  278.       msg = "Unknown symbol";
  279.       break;
  280.     case 3:
  281.       msg = "Decimal digit expected";
  282.       break;
  283.     case 4:
  284.       msg = "Type mismatch";
  285.       break;
  286.     case 5:
  287.       msg = "'=' expected";
  288.       break;
  289.     case 6:
  290.       msg = "Duplicate label";
  291.       break;
  292.     case 7:
  293.       msg = "Identifier expected";
  294.       break;
  295.     case 8:
  296.       msg = "\nUndefined label: ";
  297.       break;
  298.     case 9:
  299.       msg = "')' expected";
  300.       break;
  301.     case 10:
  302.       msg = "Expression expected";
  303.       break;
  304.     case 11:
  305.       msg = "IF without THEN";
  306.       break;
  307.     case 12:
  308.       msg = "WHILE without WEND";
  309.       break;
  310.     case 13:
  311.       msg = "Illegal expression";
  312.       break;
  313.     case 14:
  314.       msg = "'(' expected";
  315.       break;
  316.     case 15:
  317.       msg = "IF without END IF";
  318.       break;
  319.     case 16:
  320.       msg = "',' expected";
  321.       break;
  322.     case 17:
  323.       msg = "FOR without NEXT";
  324.       break;
  325.     case 18:
  326.       msg = "String constant expected";
  327.       break;
  328.     case 19:
  329.       msg = "Variable expected";
  330.       break;
  331.     case 20:
  332.       msg = "'b' or 'bf' expected";
  333.       break;
  334.     case 21:
  335.       msg = "'-' expected";
  336.       break;
  337.     case 22:
  338.       msg = "Array already dimensioned";
  339.       break;
  340.     case 23:
  341.       msg = "Illegal array index";
  342.       break;
  343.     case 24:
  344.       msg = "Illegal use of identifier";
  345.       break;
  346.     case 25:
  347.       msg = "READ without DATA";
  348.       break;
  349.     case 26:
  350.       msg = "Constant expected";
  351.       break;
  352.     case 27:
  353.       msg = "Numeric constant expected";
  354.       break;
  355.     case 28:
  356.       msg = "Short integer array expected";
  357.       break;
  358.     case 29:
  359.       msg = "Radius expected";
  360.       break;
  361.     case 30:
  362.       msg = "No start angle specified";
  363.       break;
  364.     case 31:
  365.       msg = "Illegal letter-range";
  366.       break;
  367.     case 32:
  368.       msg = "Subprogram name expected";
  369.       break;
  370.     case 33:
  371.       msg = "Duplicate subprogram/function name";
  372.       break;
  373.     case 34:
  374.       msg = "SUB without END SUB";
  375.       break;
  376.     case 35:
  377.       msg = "SUB expected";
  378.       break;
  379.     case 36:
  380.       msg = "EXIT SUB illegal outside subprogram";
  381.       break;
  382.     case 37:
  383.       msg = "CALL to undeclared subprogram";
  384.       break;
  385.     case 38:
  386.       msg = "Parameter already declared";
  387.       break;
  388.     case 39:
  389.       msg = "Parameter count mismatch";
  390.       break;
  391.     case 40:
  392.       msg = "Object cannot be shared";
  393.       break;
  394.     case 41:
  395.       msg = "Zero or negative string size";
  396.       break;
  397.     case 42:
  398.       msg = "Too many parameters in SUB";
  399.       break;
  400.     case 43:
  401.       msg = "Invalid object";
  402.       break;
  403.     case 44:
  404.       msg = "'#' expected";
  405.       break;
  406.     case 45:
  407.       msg = "Library already open";
  408.       break;
  409.     case 46:
  410.       msg = "Library not open";
  411.       break;
  412.     case 47:
  413.       msg = "FUNCTION expected";
  414.       break;
  415.     case 48:
  416.       msg = "LIBRARY expected";
  417.       break;
  418.     case 49:
  419.       msg = "Unknown library function";
  420.       break;
  421.     case 50:
  422.       msg = "Can't open bmap file";
  423.       break;
  424.     case 51:
  425.       msg = "REPEAT without UNTIL";
  426.       break;
  427.     case 52:
  428.       msg = "CASE without END CASE";
  429.       break;
  430.     case 53:
  431.       msg = "Unable to reassign a constant";
  432.       break;
  433.     case 54:
  434.       msg = "Variable exists";
  435.       break;
  436.     case 55:
  437.       msg = "Event specifier expected";
  438.       break;
  439.     case 56:
  440.       msg = "GOSUB, GOTO or CALL expected";
  441.       break;
  442.     case 57:
  443.       msg = "Label, line number or SUB name expected";
  444.       break;
  445.     case 58:
  446.       msg = "ON, OFF or STOP expected";
  447.       break;
  448.     case 59:
  449.       msg = "No event trapping label or SUB defined for this event";
  450.       break;
  451.     case 60:
  452.       msg = "Identifier or Type expected";
  453.       break;
  454.     case 61:
  455.       msg = "Duplicate structure member";
  456.       break;
  457.     case 62:
  458.       msg = "Structure type already defined";
  459.       break;
  460.     case 63:
  461.       msg = "Member type declaration expected";
  462.       break;
  463.     case 64:
  464.       msg = "STRUCT without END STRUCT";
  465.       break;
  466.     case 65:
  467.       msg = "Unknown structure type";
  468.       break;
  469.     case 66:
  470.       msg = "Structure already declared";
  471.       break;
  472.     case 67:
  473.       msg = "Not a structure member";
  474.       break;
  475.     case 68:
  476.       msg = "Unrecognised or incorrectly used command/function";
  477.       break;
  478.     case 69:
  479.       msg = "SHARED can only be used inside a subprogram";
  480.       break;
  481.     case 70:
  482.       msg = "FOR loop index cannot be a shared variable";
  483.       break;
  484.     case 71:
  485.       msg = "Undefined function or array not dimensioned";
  486.       break;
  487.     case 72:
  488.       msg = "AS expected";
  489.       break;
  490.     case 73:
  491.       msg = "ASSEM without END ASSEM";
  492.       break;
  493.     case 74:
  494.       msg = "Compiler directive expected";
  495.       break;
  496.     case 75:
  497.       msg = "OPEN, CLOSE, READ, WRITE or NAME expected";
  498.       break;
  499.     case 76:
  500.       msg = "Unable to open another library";
  501.       break;
  502.     case 77:
  503.       msg = "OPEN, CLOSE, READ, WRITE, WAIT or CLEAR expected";
  504.       break;
  505.     case 78:
  506.       msg = "An event trapping SUB may not have a parameter list";
  507.       break;
  508.     case 79:
  509.       msg = "Structure variable expected";
  510.       break;
  511.     case 80:
  512.       msg = "BLOCK without END BLOCK";
  513.       break;
  514.     }
  515.  
  516.   /* show the error */
  517.   printf ("%s", msg);
  518.   if (error_log)
  519.     fprintf (err_log, "%s", msg);
  520.   if (n > 1 && n != 8)
  521.     {
  522.       printf (" in line %d.\n", badline);
  523.       if (error_log)
  524.     fprintf (err_log, " in line %d.\n", badline);
  525.     }
  526.  
  527.   if (n != 0)
  528.     errors++;
  529. }
  530.  
  531. void _abort (int n)
  532. {
  533.   _error (n);
  534.   printf ("*** compilation aborted with %d error(s).\n", errors);
  535.   early_exit = TRUE;
  536.   kill_all_lists ();
  537.   cleanup ();
  538. }
  539.  
  540. void open_files (char *source)
  541. {
  542.   int cc;
  543.   char *xtn;
  544.  
  545.   /* 
  546.      ** Open source file: allocate memory for extension in case required.
  547.    */
  548.   srcfile = (char *) alloc (strlen (source) + 3, MEMF_ANY);    /* 3 = 2*Xtn + EOS */
  549.   if (srcfile == NULL)
  550.     {
  551.       puts ("can't allocate memory for source file name.");
  552.       early_exit = TRUE;
  553.       cleanup ();
  554.     }
  555.  
  556.   /* copy source file name */
  557.   strcpy (srcfile, source);
  558.  
  559.   /* 
  560.      ** Does source file name already have an extension (.b or .bas)? 
  561.      ** If not, add one. 
  562.    */
  563.   cc = 0;
  564.   while (srcfile[cc] && srcfile[cc] != '.')
  565.     cc++;
  566.  
  567.   xtn = &srcfile[cc];
  568.  
  569.   /*
  570.      ** Allow an extension of ".bas",".BAS",
  571.      ** ".b" or ".B". If none is present -> append ".b".
  572.    */
  573.   if (strcmp (xtn, ".bas") != 0 && strcmp (xtn, ".BAS") != 0 &&
  574.       strcmp (xtn, ".b") != 0 && strcmp (xtn, ".B") != 0)
  575.     strcat (srcfile, ".b");
  576.  
  577.   /* open source file */
  578.   if ((src = fopen (srcfile, "r")) == NULL)
  579.     {
  580.       printf ("can't open %s.\n", srcfile);
  581.       early_exit = TRUE;
  582.       cleanup ();
  583.     }
  584.  
  585.   /* 
  586.      ** Open object file. 
  587.    */
  588.   destfile = (char *) alloc (strlen (srcfile) + 1, MEMF_ANY);
  589.   if (destfile == NULL)
  590.     {
  591.       puts ("can't allocate memory for object file name.");
  592.       early_exit = TRUE;
  593.       cleanup ();
  594.     }
  595.  
  596.   /* copy source file name and change extension to ".s" */
  597.   cc = 0;
  598.   while (srcfile[cc] != '.')
  599.     {
  600.       destfile[cc] = srcfile[cc];
  601.       cc++;
  602.     }
  603.   destfile[cc] = '\0';
  604.   strcat (destfile, ".s");
  605.  
  606.   /* open target file */
  607.   if ((dest = fopen (destfile, "w")) == NULL)
  608.     {
  609.       printf ("can't write to %s.\n", destfile);
  610.       early_exit = TRUE;
  611.       cleanup ();
  612.     }
  613. }
  614.  
  615. void nextch (void)
  616. /* character handler */
  617. {
  618.   char lineno_buf[15], *tmp;
  619.   int i; 
  620.   long n;
  621.  
  622.   /* if user hits ctrl-c clean up and abort. */
  623.   if (SetSignal (0L, SIGBREAKF_CTRL_C) & SIGBREAKF_CTRL_C)
  624.     {
  625.       puts ("\n*** Break: ACE terminating.");
  626.       early_exit = TRUE;
  627.       kill_all_lists ();
  628.       cleanup ();
  629.     }
  630.  
  631.   if (column == linelen)
  632.     {
  633.       strcpy (lastline, line);
  634.  
  635.       /* refill line buffer */
  636.       column = linelen = -1;
  637.  
  638.       do
  639.     {
  640.       line[++linelen] = (ch = getc (src));
  641.     }
  642.       while ((ch != '\n') && (ch != EOF) && (linelen < MAXLINELEN));
  643.  
  644.       /* next line of source code */
  645.       line[linelen] = '\0';
  646.  
  647.       /* 
  648.          ** !!! eoln for previous line [PRINT statement etc] !!! 
  649.          **
  650.          ** Having just refilled the line buffer means we've
  651.          ** run out of characters, so reached the eoln. The last
  652.          ** character was '\0' which will be treated as whitespace
  653.          ** but which is required for string literal parsing.
  654.          **
  655.          ** If the previous line's last non-whitespace character is '~' the line 
  656.          ** should be continued (ie. the eoln should be ignored) and the '~' 
  657.          ** character should be seen as whitespace.
  658.          **
  659.          ** Geez this whole EOLN thing is _messy_!!
  660.        */
  661.       tmp = lastline;
  662.       while (*tmp)
  663.     tmp++;            /* find EOS */
  664.       while (tmp > lastline && *tmp <= ' ')
  665.     tmp--;            /* find '~' */
  666.       if (*tmp != '~')
  667.     sym = endofline;
  668.  
  669.       /* advance line counter */
  670.       lineno++;
  671.  
  672.       /* 
  673.          ** Check for EOF -> Due to some editors, last line may not have 
  674.          **               a LF, but parse it! Next time nextch() is called
  675.          **               EOF will be detected immediately. 
  676.        */
  677.       if (ch == EOF && linelen == 0)
  678.     {
  679.       if ((lineno == 0) && (linelen == 0))
  680.         _abort (1);
  681.       else
  682.         end_of_source = TRUE;
  683.     }
  684.  
  685.       /* line count display */
  686.       if (!list_source && ((lineno % 10 == 0) || end_of_source))
  687.     {
  688.       n = lineno;
  689.       if (end_of_source && linelen == 0)
  690.         --n;
  691.       printf ("\rCompiling line %s", itoa (n, lineno_buf, 10));
  692.       for (i = 1; i <= strlen (lineno_buf); i++)
  693.         putchar ('\b');
  694.       fflush (stdout);
  695.     }
  696.  
  697.       if (!end_of_source)
  698.     {
  699.       /* use source code line as a comment? */
  700.       if (asm_comments)
  701.         gen ("; *** ", line, "  ");
  702.  
  703.       /* show each source code line before compilation? */
  704.       if (list_source)
  705.         printf ("%ld: %s\n", lineno, line);
  706.     }
  707.     }
  708.  
  709.   /* next character */
  710.   column++;
  711.   ut_ch = ch = line[column];
  712.   if (ch == '~' && !inside_string)
  713.     ut_ch = ch = ' ';        /* '~' == whitespace */
  714. }
  715.  
  716. BOOL letter (void)
  717. {
  718.   if ((ch >= 'A') && (ch <= 'Z'))
  719.     return (TRUE);
  720.   if ((ch >= 'a') && (ch <= 'z'))
  721.     {
  722.       ch -= 32;
  723.       return (TRUE);
  724.     }
  725.   return (FALSE);
  726. }
  727.  
  728. BOOL digit (void)
  729. {
  730.   if ((ch >= '0') && (ch <= '9'))
  731.     return (TRUE);
  732.   else
  733.     return (FALSE);
  734. }
  735.  
  736. int hex_digit (void)
  737. {
  738.   if ((ch >= '0') && (ch <= '9'))
  739.     return (ch - '0');
  740.   letter ();            /* make sure it's uppercase */
  741.   if ((ch >= 'A') && (ch <= 'F'))
  742.     return (10 + ch - 'A');
  743.   return (-1);
  744. }
  745.  
  746. int octal_digit (void)
  747. {
  748.   if ((ch >= '0') && (ch <= '7'))
  749.     return (ch - '0');
  750.   return (-1);
  751. }
  752.  
  753. void convert_special_ident (void)
  754. {
  755. /* 
  756.    ** If the current identifier is one of a special 
  757.    ** group, modify it by prefixing an underscore.
  758.    **
  759.    ** This is a kludge to get around problems with
  760.    ** certain names (eg: 68000 register names)
  761.    ** which cause A68K to generate errors when
  762.    ** encountered as labels. 
  763.  */
  764.   char chr0, chr1;
  765.  
  766.   chr0 = id[0];
  767.   chr1 = id[1];
  768.  
  769.   /* 
  770.      ** Address or data register name? (A0..A7, D0..D7 or SP)
  771.      ** If so -> convert to _Dn, _An or _SP.
  772.    */
  773.   if (((chr0 == 'A' || chr0 == 'D') &&
  774.        (chr1 >= '0' && chr1 <= '7' && id[2] == '\0')) ||
  775.       (chr0 == 'S' && chr1 == 'P' && id[2] == '\0'))
  776.     {
  777.       /* convert id */
  778.       id[3] = '\0';
  779.       id[2] = chr1;
  780.       id[1] = chr0;
  781.       id[0] = '_';
  782.     }
  783. }
  784.  
  785. BOOL qualifier (void)
  786. {
  787.   /* - Attach a qualifier character (%&$!#).
  788.      - The default object (variable) can be overriden by
  789.      the later declaration of an array, subprogram etc.
  790.    */
  791.  
  792.   switch (ch)
  793.     {
  794.     case '$':
  795.       obj = variable;
  796.       typ = stringtype;
  797.       return (TRUE);
  798.     case '%':
  799.       obj = variable;
  800.       typ = shorttype;
  801.       return (TRUE);
  802.     case '&':
  803.       obj = variable;
  804.       typ = longtype;
  805.       return (TRUE);
  806.     case '!':
  807.       obj = variable;
  808.       typ = singletype;
  809.       return (TRUE);
  810.     case '#':
  811.       obj = variable;
  812.       typ = singletype;
  813.       return (TRUE);
  814.     default:
  815.       obj = undefined;
  816.       typ = undefined;
  817.       return (FALSE);
  818.     }
  819. }
  820.  
  821. BOOL ssymbol (void)
  822. {
  823.   int i = 0;
  824.   BOOL found = FALSE;
  825.  
  826.   /* if (ch == '"') return(TRUE); */
  827.   while ((spec_sym[i] != '\0') && (!found))
  828.     if (ch == spec_sym[i++])
  829.       found = TRUE;
  830.   return (found);
  831. }
  832.  
  833. int rsvd_wd (char *id)
  834. {
  835.   BOOL found = FALSE;
  836.   int first, last, this;
  837.  
  838.   /* search the reserved word
  839.      list using a binary search 
  840.      for AmigaBASIC and then ACE 
  841.      keywords.
  842.    */
  843.  
  844.   /* AmigaBASIC keyword? */
  845.   first = abssym;
  846.   last = xorsym;
  847.   do
  848.     {
  849.       this = (first + last) / 2;
  850.       if (strcmp (id, rword[this]) <= 0)
  851.     last = this - 1;    /* id <= rword[this] ? */
  852.       if (strcmp (id, rword[this]) >= 0)
  853.     first = this + 1;    /* id >= rword[this] ? */
  854.     }
  855.   while (first <= last);
  856.   if (first - 1 > last)
  857.     found = TRUE;
  858.  
  859.   /* ACE keyword? */
  860.   if (!found)
  861.     {
  862.       first = addresssym;
  863.       last = ycorsym;
  864.       do
  865.     {
  866.       this = (first + last) / 2;
  867.       if (strcmp (id, rword[this]) <= 0)
  868.         last = this - 1;    /* id <= rword[this] ? */
  869.       if (strcmp (id, rword[this]) >= 0)
  870.         first = this + 1;    /* id >= rword[this] ? */
  871.     }
  872.       while (first <= last);
  873.       if (first - 1 > last)
  874.     found = TRUE;
  875.     }
  876.  
  877.   if (found)
  878.     return (this);
  879.   else
  880.     return (undefined);
  881. }
  882.  
  883. int rsvd_sym (char *id)
  884. {
  885.   BOOL found = FALSE;
  886.   int cc = 0;
  887.  
  888.   /* reserved symbol? */
  889.   do
  890.     {
  891.       if (strcmp (id, rsym[cc++]) == 0)
  892.     found = TRUE;
  893.     }
  894.   while ((!found) && (strcmp (rsym[cc], "SENTINEL") != 0));
  895.   if (found)
  896.     return (500 + cc - 1);
  897.   else
  898.     return (undefined);
  899. }
  900.  
  901. void reclassify_number (void)
  902. {
  903.   /* reclassify a number as a short, long or floating point value
  904.      if a qualifying character (%&!#) follows the numeric literal.
  905.    */
  906.   if (ch == '%')
  907.     {
  908.       /* coerce to a SHORT constant */
  909.       nextch ();
  910.       switch (typ)
  911.     {
  912.     case longtype:
  913.       shortval = (SHORT) longval;
  914.       break;
  915.     case singletype:
  916.       if (SPCmp (0.5, SPSub (SPFloor (singleval), singleval)) == 1)
  917.         shortval = (SHORT) SPFix (SPFloor (singleval));
  918.       else
  919.         shortval = (SHORT) SPFix (SPCeil (singleval));
  920.       break;        /*if fnum-fix(fnum)<0.5 round_down else round_up */
  921.     }
  922.       sym = shortconst;
  923.       typ = shorttype;
  924.     }
  925.   else if (ch == '&')
  926.     {
  927.       /* coerce to a LONG constant */
  928.       nextch ();
  929.       switch (typ)
  930.     {
  931.     case shorttype:
  932.       longval = (LONG) shortval;
  933.       break;
  934.     case singletype:
  935.       if (SPCmp (0.5, SPSub (SPFloor (singleval), singleval)) == 1)
  936.         longval = (LONG) SPFix (SPFloor (singleval));
  937.       else
  938.         longval = (LONG) SPFix (SPCeil (singleval));
  939.       break;        /*if fnum-fix(fnum)<0.5 round_down else round_up */
  940.     }
  941.       sym = longconst;
  942.       typ = longtype;
  943.     }
  944.   else if (ch == '!' || ch == '#')
  945.     {
  946.       /* coerce to a SINGLE constant */
  947.       nextch ();
  948.       switch (typ)
  949.     {
  950.     case shorttype:
  951.       singleval = SPFlt ((LONG) shortval);
  952.       break;
  953.     case longtype:
  954.       singleval = SPFlt (longval);
  955.       break;
  956.     }
  957.       sym = singleconst;
  958.       typ = singletype;
  959.     }
  960. }
  961.  
  962. void classify_integer (LONG n)
  963. {
  964.   /* classify as a long or short integer value */
  965.   if (n >= 0 && n <= MAXSHORT)
  966.     {
  967.       /* SHORT constant */
  968.       shortval = (SHORT) n;
  969.       sym = shortconst;
  970.       typ = shorttype;
  971.     }
  972.   else
  973.     {
  974.       /* LONG constant */
  975.       longval = n;
  976.       sym = longconst;
  977.       typ = longtype;
  978.     }
  979. }
  980.  
  981. void insymbol (void)
  982. /* lexical analyser */
  983. {
  984.   int i, cc = 0;
  985.   char ssym[3];
  986.   LONG n[2], n0, n1;
  987.   int index;
  988.   int periods;
  989.   BOOL period;
  990.   LONG places;
  991.   int placecount;
  992. /*  int ex;                  no reference */
  993.   LONG val;
  994.   BYTE num;
  995.   int sign;
  996.   char lastch = ' ';
  997.  
  998.   lastsym = sym;
  999.   sym = undefined;
  1000.   obj = undefined;
  1001.   typ = undefined;
  1002.  
  1003.   if (!end_of_source)
  1004.     {
  1005.       /* skip whitespace */
  1006.       while (ch <= ' ')
  1007.     {
  1008.       nextch ();
  1009.       if (end_of_source)
  1010.         return;
  1011.       if (sym == endofline)
  1012.         return;        /* for PRINT */
  1013.     }
  1014.  
  1015.       /* single-line comment? */
  1016.       if (ch == '\'')
  1017.     {
  1018.       do
  1019.         {
  1020.           nextch ();
  1021.         }
  1022.       while ((sym != endofline) && (!end_of_source));
  1023.       if (end_of_source)
  1024.         return;
  1025.       if (sym == endofline)
  1026.         return;        /* for PRINT '... */
  1027.     }
  1028.  
  1029.       /* block comment? */
  1030.       if (ch == '{')
  1031.     {
  1032.       do
  1033.         {
  1034.           nextch ();
  1035.         }
  1036.       while ((ch != '}') && (!end_of_source));
  1037.  
  1038.       if (!end_of_source)
  1039.         nextch ();        /* character after "}" */
  1040.       else
  1041.         return;
  1042.  
  1043.       if (sym == endofline)
  1044.         return;        /* for PRINT {..} */
  1045.  
  1046.       /* skip whitespace */
  1047.       while (ch <= ' ')
  1048.         {
  1049.           nextch ();
  1050.           if (end_of_source)
  1051.         return;
  1052.           if (sym == endofline)
  1053.         return;        /* for PRINT {..} eoln */
  1054.         }
  1055.     }
  1056.  
  1057.       /* identifier or reserved word? */
  1058.       if (letter () || (ch == '_'))
  1059.     {
  1060.       do
  1061.         {
  1062.           ut_id[cc] = ut_ch;    /* keep an "untouched" version 
  1063.                             (ie: upper/lower case) 
  1064.                             for DATA statements, library function searches 
  1065.                             and external functions */
  1066.           id[cc++] = ch;
  1067.           nextch ();
  1068.         }
  1069.       while ((letter () || digit () || (ch == '.') || (ch == '_')) &&
  1070.          (cc < MAXIDSIZE - 2));
  1071.  
  1072.       id[cc] = '\0';
  1073.       ut_id[cc] = '\0';
  1074.  
  1075.       /* is there a qualifier? %&$!# */
  1076.       if (qualifier ())
  1077.         {
  1078.           if (ch == '&')
  1079.         ch = '@';
  1080.           if (ch == '!')
  1081.         ch = '[';    /* this is ONLY because a jsr SUB_name& or
  1082.                    SUB_name! gives an error in A68K, whereas
  1083.                    SUB_name@ and SUB_name[ don't!! */
  1084.           id[cc++] = ch;
  1085.           nextch ();
  1086.         }
  1087.  
  1088.       id[cc] = '\0';
  1089.       ut_id[cc] = '\0';
  1090.  
  1091.       /* reserved word? */
  1092.       if ((sym = rsvd_wd (id)) == undefined)
  1093.         {
  1094.           /* no, it's an identifier */
  1095.           convert_special_ident ();
  1096.  
  1097.           sym = ident;
  1098.  
  1099.           if (typ == undefined)
  1100.         {
  1101.           /* 
  1102.              ** Data type = ASCII value of 1st char in id minus 'A'.
  1103.              ** Note that the underscore character is also catered
  1104.              ** for here since it is higher in the ASCII table than
  1105.              ** "Z". See lexvar.c, misc.c and setup() (above) for 
  1106.              ** more info.
  1107.            */
  1108.           typ = idtype[id[0] - 'A'];
  1109.  
  1110.           obj = variable;
  1111.         }
  1112.         }
  1113.       else
  1114.         {
  1115.           /* 
  1116.              ** It's a reserved word, so typ & obj mean nothing, but may
  1117.              ** have been set by qualifier() if qualifier character was a '$' 
  1118.            */
  1119.           typ = undefined;
  1120.           obj = rsvd_word;
  1121.         }
  1122.     }
  1123.       else
  1124.     /* string constant? */
  1125.       if (ch == '"')
  1126.     {
  1127.       inside_string = TRUE;
  1128.       cc = 0;
  1129.       do
  1130.         {
  1131.           nextch ();
  1132.           stringval[cc++] = ch;
  1133.         }
  1134.       while ((ch != '"') && (ch != '\0') && (cc < MAXSTRLEN));
  1135.       if (ch == '"')
  1136.         --cc;
  1137.       if (ch == '"')
  1138.         nextch ();
  1139.       stringval[cc] = '\0';
  1140.       sym = stringconst;
  1141.       typ = stringtype;
  1142.       obj = constant;
  1143.       inside_string = FALSE;
  1144.     }
  1145.       else
  1146.     /* numeric literal? */
  1147.       if (digit () || (ch == '.'))
  1148.     {
  1149.       n[0] = n[1] = 0;
  1150.       index = 0;
  1151.       period = FALSE;
  1152.       periods = 0;
  1153.       placecount = 0;
  1154.  
  1155.       /* is first char '.'? */
  1156.       if (ch == '.')
  1157.         {
  1158.           period = TRUE;
  1159.           placecount = 0;
  1160.           index = 1;
  1161.           periods++;
  1162.         }
  1163.       /* get the value */
  1164.       if (!period)
  1165.         n[0] = 10 * n[0] + (ch - '0');
  1166.       do
  1167.         {
  1168.           nextch ();
  1169.           if (digit ())
  1170.         n[index] = 10 * n[index] + (ch - '0');
  1171.           if (digit () && period)
  1172.         placecount++;
  1173.           if (ch == '.')
  1174.         periods++;
  1175.           if ((ch == '.') && (!period))
  1176.         {
  1177.           period = TRUE;
  1178.           placecount = 0;
  1179.           index = 1;
  1180.         }
  1181.         }
  1182.       while ((digit () || ch == '.') && (periods <= 1));
  1183.  
  1184.       /* integer or real? */
  1185.       if (period && (periods == 1))
  1186.         {
  1187.           /* make FFP */
  1188.           sym = singleconst;
  1189.           typ = singletype;
  1190.           places = 1;
  1191.           for (i = 1; i <= placecount; i++)
  1192.         places *= 10;
  1193.           n0 = n[0];
  1194.           n1 = n[1];
  1195.           singleval = SPAdd (SPFlt (n0), SPDiv (SPFlt (places), SPFlt (n1)));
  1196.  
  1197. /*        printf("%lx\n",singleval);      original   */
  1198. /*        printf("%x\n",singleval);         */
  1199. /*          char ffpbuf[20];
  1200.            ex = fpa(singleval,ffpbuf);
  1201.     printf("%f\n",singleval);
  1202.              ffpbuf[14]='\0'; 
  1203.              printf("FFP: %s\t%lx\t",ffpbuf,singleval);
  1204.              ffprint(ex,ffpbuf);  */
  1205.         }
  1206.       else
  1207.         classify_integer (n[0]);
  1208.  
  1209.       reclassify_number ();
  1210.  
  1211.       /* is it a real in scientific format? */
  1212.       if ((ch == 'e') || (ch == 'E'))
  1213.         {
  1214.           long ex = 0;
  1215.           sign = 1;
  1216.           nextch ();
  1217.           if (ch == '+')
  1218.         {
  1219.           sign = 1;
  1220.           nextch ();
  1221.         }
  1222.           else if (ch == '-')
  1223.         {
  1224.           sign = -1;
  1225.           nextch ();
  1226.         }
  1227.           if (!digit ())
  1228.         _error (3);    /* expect a digit */
  1229.           /* get digits */
  1230.           while (digit ())
  1231.         {
  1232.           ex = 10 * ex + (ch - 48);
  1233.           nextch ();
  1234.         }
  1235.           ex *= sign;
  1236.           /* convert to FFP */
  1237.           if ((ex >= -20) && (ex <= 18))
  1238.         {
  1239.  
  1240.           /* mantissa */
  1241.           if (sym != singleconst)
  1242.             {
  1243.               singleval = SPFlt (n[0]);
  1244.               sym = singleconst;
  1245.               typ = singletype;
  1246.             }
  1247.  
  1248.           /* if exponent is zero: 10^ex = 1 -> num*1 = num 
  1249.              so just return singleval as it is. */
  1250.           if (ex != 0)
  1251.             singleval = SPMul (SPPow (SPFlt (ex), 10.0), singleval);
  1252.  
  1253.           reclassify_number ();
  1254.         }
  1255.           else
  1256.         {
  1257.           singleval = 0.0;
  1258.           _warn (1);
  1259.         }
  1260.         }
  1261.       obj = constant;
  1262.     }
  1263.       else
  1264.     /* reserved symbol? */
  1265.       if (ch == '\\')        /* backslash */
  1266.     {
  1267.       sym = idiv;
  1268.       nextch ();
  1269.     }
  1270.       else if (ssymbol () || (ch == '&') || (ch == '#'))
  1271.     {
  1272.       /* one character symbol? */
  1273.       ssym[0] = ch;
  1274.       ssym[1] = '\0';
  1275.       sym = rsvd_sym (ssym);    /* tentatively */
  1276.  
  1277.       lastch = ch;        /* might be '&' or '*' */
  1278.       nextch ();
  1279.  
  1280.       /* multiple character symbol? (++,--,->,<>,<=,>=,:=,&H,&O,*%,*&,*!) */
  1281.  
  1282.       /* ++ */
  1283.       if (sym == plus && ch == '+')
  1284.         {
  1285.           ssym[1] = ch;
  1286.           ssym[2] = '\0';
  1287.           sym = rsvd_sym (ssym);
  1288.           nextch ();
  1289.         }
  1290.       else
  1291.         /* --,-> */
  1292.       if (sym == minus && (ch == '-' || ch == '>'))
  1293.         {
  1294.           ssym[1] = ch;
  1295.           ssym[2] = '\0';
  1296.           sym = rsvd_sym (ssym);
  1297.           nextch ();
  1298.         }
  1299.       else
  1300.         /* <>,<= */
  1301.       if (sym == lessthan && (ch == '>' || ch == '='))
  1302.         {
  1303.           ssym[1] = ch;
  1304.           ssym[2] = '\0';
  1305.           sym = rsvd_sym (ssym);
  1306.           nextch ();
  1307.         }
  1308.       else
  1309.         /* >=,:= */
  1310.       if ((sym == gtrthan || sym == colon) && ch == '=')
  1311.         {
  1312.           ssym[1] = ch;
  1313.           ssym[2] = '\0';
  1314.           sym = rsvd_sym (ssym);
  1315.           nextch ();
  1316.         }
  1317.       else
  1318.         /* &H,&O */
  1319.       if (lastch == '&' && (ch == 'H' || ch == 'O'))
  1320.         {
  1321.           ssym[1] = ch;
  1322.           ssym[2] = '\0';
  1323.           sym = rsvd_sym (ssym);
  1324.           nextch ();
  1325.         }
  1326.       else
  1327.         /* *%,*&,*! */
  1328.       if (lastch == '*' && (ch == '%' || ch == '&' || ch == '!'))
  1329.         {
  1330.           ssym[1] = ch;
  1331.           ssym[2] = '\0';
  1332.           sym = rsvd_sym (ssym);
  1333.           nextch ();
  1334.         }
  1335.  
  1336.  
  1337.       /* hexadecimal constant? */
  1338.       if (sym == hexprefix)
  1339.         {
  1340.           val = 0;
  1341.           if (hex_digit () == -1)
  1342.         _error (2);
  1343.           else
  1344.         while ((num = hex_digit ()) != -1)
  1345.           {
  1346.             val = 16 * val + num;
  1347.             nextch ();
  1348.           }
  1349.           classify_integer (val);
  1350.           reclassify_number ();
  1351.         }
  1352.       else
  1353.         /* octal constant? */
  1354.       if ((sym == octalprefix) || ((ssym[0] == '&') && (strlen (ssym) == 1)))
  1355.         {
  1356.           val = 0;
  1357.           if (octal_digit () == -1)
  1358.         _error (2);
  1359.           else
  1360.         {
  1361.           while ((num = octal_digit ()) != -1)
  1362.             {
  1363.               val = 8 * val + num;
  1364.               nextch ();
  1365.             }
  1366.           classify_integer (val);
  1367.           reclassify_number ();
  1368.         }
  1369.         }
  1370.     }
  1371.       /*
  1372.          ** Unknown symbol.
  1373.        */
  1374.       if (sym == undefined)
  1375.     {
  1376.       _error (2);
  1377.       nextch ();
  1378.     }
  1379.       /*showsym(sym); lf(); */
  1380.     }
  1381. }
  1382.  
  1383. /*
  1384.    void showsym(int sym)
  1385.    {
  1386.    if (sym == undefined) printf("undefined");
  1387.    else
  1388.    if (sym <= RWSENTINEL) printf("%s -> %d",rword[sym],sym);
  1389.    else
  1390.    if (sym <= RSSENTINEL) printf("%s",rsym[sym-500]);
  1391.    else
  1392.    printf("%s",symbol[sym-1000]);
  1393.    }
  1394.  
  1395.    void showobj(int obj)
  1396.    {
  1397.    if (obj == undefined) printf(" undefined");
  1398.    else
  1399.    printf("%10s",object[obj-3000]);
  1400.    }
  1401.  
  1402.    void showtyp(int typ)
  1403.    {
  1404.    if (typ == undefined) printf(" undefined");
  1405.    else
  1406.    printf("%10s",type[typ-2000]);
  1407.    }
  1408.  
  1409.    void tab(void)
  1410.    {
  1411.    putchar('\t');
  1412.    }
  1413.  
  1414.    void lf(void)
  1415.    {
  1416.    putchar('\n');
  1417.    }
  1418.  */
  1419.  
  1420. /*
  1421.    void main(int argc,char *argv[])
  1422.    {
  1423.    if (argc == 1) { src = stdin; std_in=TRUE; }
  1424.    else
  1425.    open_files(argv[1]);
  1426.    setup();
  1427.    while (!end_of_source) 
  1428.    { 
  1429.    insymbol(); 
  1430.    puts("                             ");
  1431.    showsym(sym); tab(); 
  1432.    showobj(obj); tab(); 
  1433.    showtyp(typ); lf(); 
  1434.    switch(sym)
  1435.    {
  1436.    case stringconst : printf("-->>%s\n",stringval); break;
  1437.    case shortconst  : printf("-->>%d\n",shortval);  break;
  1438.    case longconst   : printf("-->>%ld\n",longval);  break;
  1439.    case singleconst : printf("-->>%x\n",singleval); break;
  1440.    }
  1441.    }
  1442.    cleanup();
  1443.    }
  1444.  */
  1445.